home *** CD-ROM | disk | FTP | other *** search
Text File | 1992-06-07 | 8.6 KB | 240 lines | [TEXT/CCL2] |
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- ;;RSA
- ;;
- ;; The algorithms come from two papers
- ;;
- ;; R.L. Rivest, A. Shamir, and L. Adelman
- ;; A Method for Obtaining Digital Signatures and Public Key Crypto-Systems
- ;; CACM, (1978), pp.120-126
- ;;
- ;; R. Solovay and V. Strassen
- ;; A Fast Monte-Carlo Test for Primality
- ;; SIAM Journal on Computing, (1977), pp.84-85.
-
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
- ;;;This function RSA encrypts the specified string
- (defun RSA-encode-string (in-string public-key)
- (with-input-from-string (in in-string)
- (with-output-to-string (out)
- (RSA-encode-stream in out public-key))))
-
-
- ;;;This function RSA decrypts the specified string
- (defun RSA-decode-string (in-string private-key)
- (with-input-from-string (in in-string)
- (with-output-to-string (out)
- (RSA-decode-stream in out private-key))))
-
-
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
- ;;;This function RSA encrypts the specified file
- (defun RSA-encode-file (in-pathname out-pathname public-key)
- (with-open-file (in in-pathname
- :direction :input)
- (with-open-file (out out-pathname
- :direction :output
- :if-exists :rename-and-delete
- :if-does-not-exist :create)
- (RSA-encode-stream in out public-key))))
-
-
- ;;;This function RSA decrypts the specified file
- (defun RSA-decode-file (in-pathname out-pathname private-key)
- (with-open-file (in in-pathname
- :direction :input)
- (with-open-file (out out-pathname
- :direction :output
- :if-exists :rename-and-delete
- :if-does-not-exist :create)
- (RSA-decode-stream in out private-key))))
-
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
- ;;;This function RSA encrypts the specified input stream
- ;;; and puts the encrypted data onto the specified output stream
- (defun RSA-encode-stream (in-stream out-stream public-key)
- (let* ((block-size (1- (RSA-block-size public-key)))
- (block (make-string block-size))
- (i 0))
- (loop
- (when (null (listen in-stream)) (return i))
- (incf i)
- (dotimes (i block-size)
- (setf (char block i) (read-char in-stream nil (code-char 0))))
- (princ (RSA-encode-block block public-key) out-stream))))
-
-
- ;;;This function RSA decrypts the specified input stream
- ;;; and puts the decrypted data onto the specified output stream
- (defun RSA-decode-stream (in-stream out-stream private-key)
- (let* ((block-size (RSA-block-size private-key))
- (block (make-string block-size))
- (i 0))
- (loop
- (when (null (listen in-stream)) (return i))
- (incf i)
- (dotimes (i block-size)
- (setf (char block i) (read-char in-stream t)))
- (princ (RSA-decode-block block private-key) out-stream))))
-
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
- ;;;This function RSA encrypts a single block of message
- (defun RSA-encode-block (string public-key)
- (let ((block-size (RSA-block-size public-key)))
- (unless (< (length string) block-size)
- (error "string too long ~a >= ~a to be correctly encoded" (length string) block-size))
- (int-to-string (expt-mod (string-to-int string) (second public-key) (first public-key))
- block-size)))
-
- ;;;This function RSA decrypts a single block of message
- (defun RSA-decode-block (string private-key)
- (int-to-string (expt-mod (string-to-int string) (second private-key) (first private-key))))
-
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
- ;;;Returns the encryption block size in character for the specified key
- (defun RSA-block-size (key)
- (prog1 (ceiling (integer-length (first key)) 8)))
-
-
- ;;;Give a pair of primes this function generates an RSA key pair from them.
- ;;;It returns 2 values, the public key and private key.
- ;;;Each key is a list of 2 numbers - the 2nd number is actually the key.
- (defun RSA-gen-keys (prime-1 prime-2)
- (let* ((p prime-1)
- (q prime-2)
- (phi (* (1- p) (1- q)))
- (pri-key (RSA-choose-private-key p q phi))
- (pub-key (multiplicative-inverse pri-key phi))
- (msg-size (* p q)))
- (values (list msg-size pub-key) (list msg-size pri-key))))
-
- ;;;Choose a private key for p,q,phi
- (defun RSA-choose-private-key (p q phi)
- (do ((d (+ (max p q) 2) (+ d 2)))
- ((eq (gcd d phi) 1) d)))
-
-
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- ;;;Solovay & Strassen prime test.
-
- ;;generates a prime of the specified number of digits
- (defun gen-prime (digits &key (certainty 20))
- (let* ((ten-expt-digits-1 (expt 10 (1- digits)))
- (ten-expt-digits (* 10 ten-expt-digits-1))
- (n (+ ten-expt-digits-1 (random (* 9 ten-expt-digits-1)))))
- (when (evenp n) (incf n))
- (dotimes (i (ceiling (- ten-expt-digits n) 2) (error "no ~a digit primes found." digits))
- (when (prime-p n certainty) (return-from gen-prime n))
- (incf n 2))))
-
- ;;;A list of the first 100 primes
- (defconstant *first-primes*
- '(1 2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89 97
- 101 103 107 109 113 127 131 137 139 149 151 157 163 167 173 179 181 191 193 197
- 199 211 223 227 229 233 239 241 251 257 263 269 271 277 281 283 293 307 311 313
- 317 331 337 347 349 353 359 367 373 379 383 389 397 401 409 419 421 431 433 439
- 443 449 457 461 463 467 479 487 491 499 503 509 521 523))
-
- ;;;Returns whether n is prime with a certainty of 1 - 1/2^test-count.
- ;;;It uses an improved version of the original Solovay & Strassen
- ;;;prime test. Based on Eric Bach's suggestion of using a sequence
- ;;;of primes rather than random numbers.
- ;;; make sure num_tests <= the number of primes in *first_primes*
- (defun prime-p (n test-count)
- (unless (<= test-count (length *first-primes*))
- (error "test-count must be less than ~a." (length *first-primes*)))
- (when (oddp n)
- (let ((prime-list *first-primes*)
- (a nil))
- (dotimes (i test-count n)
- (setf a (pop prime-list))
- (cond
- ((>= a n) (return n))
- ((> (gcd a n) 1) (return nil))
- ((/= (mod (jacobi a n) n) (expt-mod a (/ (1- n) 2) n)) (return nil)))))))
-
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- ;;; misc utils
-
- ;;Returns base^power mod modulus
- ;;significantly more efficient than (mod (expt base power) modulus)
- (defun expt-mod (base power modulus)
- (if (zerop power)
- 1
- (let ((i (1- (integer-length power)))
- (result 1))
- (loop
- (when (logbitp i power)
- (setf result (mod (* result base) modulus)))
- (when (zerop i) (return result))
- (setf result (mod (* result result) modulus))
- (decf i)))))
-
-
- ;;;Returns the value of the jacobi symbol (m/n)
- (defun jacobi (m n)
- (cond
- ((= m 1) 1)
- ((or (zerop m) (evenp n)) 0)
- ((evenp m) (* (if (/= (mod n 8) 3 5) 1 -1) (jacobi (/ m 2) n)))
- (t (* (if (= (mod m 4) (mod n 4) 3) -1 1) (jacobi (mod n m) m)))))
-
-
- ;;;Returns multiplicative inverse of x1 mod x0 using the extended
- ;;;version of Euclid's algorithm. If the numbers are not relatively
- ;;;prime nil will be returned. (algorithm deduced from RSA paper)
- (defun multiplicative-inverse (n modulus)
- (labels ((multinv (x1 x0 a1 a0 b1 b0 m)
- (if (= x1 0)
- (if (= x0 1) (mod b0 m))
- (multinv (mod x0 x1) x1
- (- a0 (* (truncate x0 x1) a1)) a1
- (- b0 (* (truncate x0 x1) b1)) b1
- (if m m x0)))))
- (multinv n modulus 0 1 1 0 nil)))
-
-
- ;;;This function returns the integer equivalent to the string
- (defun string-to-int (s)
- (let ((result 0))
- (dotimes (i (length s) result)
- (setf result (dpb (char-int (char s i)) (byte 8 (* (- (length s) i 1) 8)) result)))))
-
-
- ;;;This function returns the string equivalent of an integer
- (defun int-to-string (n &optional (str-len (ceiling (integer-length n) 8)))
- (let ((result (make-string str-len)))
- (dotimes (i str-len result)
- (setf (char result i) (code-char (ldb (byte 8 (* (- str-len i 1) 8)) n))))))
-
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
- #|
-
- (defvar pub)
- (defvar pri)
-
- ;;50 digit primes -> ~100 digit keys
- (multiple-value-setq
- (pub pri)
- (RSA-gen-keys 77003373946484615565077855874935689789585714881953
- 82763142278558437608609060381372367912327955153689))
-
- ;;5 digit primes -> ~10 digit keys - faster performance
- (multiple-value-setq (pub pri) (RSA-gen-keys 47251 35747))
-
- (RSA-decode-string (RSA-encode-string "the rain in spain" pub) pri)
-
- (RSA-decode-string (RSA-encode-string "the rain in spain" pri) pub)
-
- (RSA-encode-file (choose-file-dialog) (choose-new-file-dialog) pub)
- (RSA-decode-file (choose-file-dialog) (choose-new-file-dialog) pri)
-
-
-
-
- |#